;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File:         application.lsp
; RCS:          $Header: /disk3/npm/src/widgit/examples/tk-challenge/RCS/Application.lsp,v 2.7 1994/11/04 02:55:30 npm Exp npm $
; Description:  Complete Application for "Solbourne Toolkit Challenge" this
;		is a one-file version of the code in phase1.lsp, phase2.lsp,
;		phase3.lsp, phase4.lsp, phase5.lsp.
;		10-12-94 -- rewrote some code to use WINTERP:APPLICATION-WIDGET-CLASS
;		for simplified menu bar creation, also used defclass/defmethod macros.
; Author:       Niels Mayer
; Created:      Thu Apr  2 19:38:47 1992
; Modified:     Wed May 10 01:26:47 1995 (Niels Mayer) npm@indeed
; Language:     Winterp-Lisp
; Package:      N/A
; Status:       X11r6 contrib release
;
; Copyright (C) 1994, Enterprise Integration Technologies Corp. and Niels Mayer.
; WINTERP 1.15-1.99, Copyright (c) 1993, Niels P. Mayer.
; WINTERP 1.0-1.14, Copyright (c) 1989-1992 Hewlett-Packard Co. and Niels Mayer.
; 
; Permission to use, copy, modify, distribute, and sell this software and its
; documentation for any purpose is hereby granted without fee, provided that
; the above copyright notice appear in all copies and that both that
; copyright notice and this permission notice appear in supporting
; documentation, and that the name of Enterprise Integration Technologies,
; Hewlett-Packard Company, or Niels Mayer not be used in advertising or
; publicity pertaining to distribution of the software without specific,
; written prior permission. Enterprise Integration Technologies, Hewlett-Packard
; Company, and Niels Mayer makes no representations about the suitability of
; this software for any purpose.  It is provided "as is" without express or
; implied warranty.
; 
; ENTERPRISE INTEGRATION TECHNOLOGIES, HEWLETT-PACKARD COMPANY AND NIELS MAYER
; DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED
; WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL ENTERPRISE
; INTEGRATION TECHNOLOGIES, HEWLETT-PACKARD COMPANY OR NIELS MAYER BE LIABLE
; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
; RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
; CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require "lib-utils/initialize")	;define STRCAT, etc.
(require "lib-widgets/application")	;define WINTERP:APPLICATION-WIDGET-CLASS
(require "lib-utils/motif-vers")	;define MOTIF-1.1-OR-LATER-P, MOTIF-1.1.3-OR-LATER-P
(require "lib-utils/unixstuf")		;define WINTERP-STANDALONE-P
(require "lib-utils/classes")		;define DEFCLASS and DEFMETHOD macros

;; this global constant needs to be changed if the location of the 
;; location of the help file changes.
(defvar *HELP-FILE-DIRECTORY* "/usr/local/winterp/examples/tk-challenge/help-files/")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Rolodex_Application_Widget_Class
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass Rolodex_Application_Widget_Class
  (main-w)				;declare instance vars
  ()					;no class vars
  TOP_LEVEL_SHELL_WIDGET_CLASS		;superclass
  )

(defmethod Rolodex_Application_Widget_Class :ISNEW (name-str &rest args)
  ;; create the TOP_LEVEL_SHELL_WIDGET_CLASS inst by sending :isnew to superclass
  (apply #'send-super :ISNEW name-str args)

  (setq main-w
	(send WINTERP:APPLICATION-WIDGET-CLASS :new :managed "main" self))

  (send main-w :add-menu-entry "Files"
	:mnemonic #\F
	:type :cascadebutton)
  (send main-w :add-menu-entry '("Files" "Load")
	:mnemonic #\L :accelerator "Ctrl<Key>L" :accelerator-text "Ctrl-L"
	:callback #'(lambda (wi xe) (send self :load-file)))
  (send main-w :add-menu-entry '("Files" "Exit")
	:mnemonic #\E :accelerator "Ctrl<Key>E" :accelerator-text "Ctrl-E"
	:callback #'(lambda (wi xe) (send self :exit-app)))

  (send main-w :add-menu-entry "Help"
	:mnemonic #\H
	:type :cascadebutton)
  (send main-w :add-menu-entry '("Help" "Help on Application")
	:mnemonic #\H :accelerator "Ctrl<Key>H" :accelerator-text "Ctrl-H"
	:callback #'(lambda (wi xe) (send self :app-help xe)))
  (send main-w :add-menu-entry '("Help" "Pick the widget you want help on")
	:mnemonic #\P :accelerator "CtrlMeta<Key>H" :accelerator-text "Ctrl-Meta-H"
	:callback #'(lambda (wi xe) (send self :pick-help xe)))

  (send main-w :make-menus)
  (send main-w :set-menu-help-widget)

  (send main-w :set-work-area		;create an instance of Rolodex_Form_Widget_Class
	(send Rolodex_Form_Widget_Class :new :managed
	      "rolodex-form" main-w
	      ))

  ;; Conditionalize call to wtree-recurse-install-accels -- HP UEDK Motif
  ;; (on HPUX 8.0-8.07) and Motif 1.1.1/1.1.2 core dump due to Motif bugs.
  (if *MOTIF-1.1.3-OR-LATER-P*		;only fixed on motif 1.1.3, 1.1.4, 1.1.5
      (wtree-recurse-install-accels self self)
    )

  (send self :realize)

  ;; add the main application help callback. This help text will be
  ;; come up when "Help" is requested on a widget that doesn't have
  ;; it's own help callback, or when the 'Help on Application' pulldown
  ;; is selected.
  (add-help-to-widget main-w)
  )

(defmethod Rolodex_Application_Widget_Class :LOAD-FILE ()
  (send main-w :display-string "Loading file ...")
  (let ((fsb-w
	 (send XM_FILE_SELECTION_BOX_WIDGET_CLASS :new :managed :dialog
	       "file_selection_box" main-w
	       :XMN_DELETE_RESPONSE :destroy ;resource on XM_DIALOG_POPUP_SHELL_WIDGET_CLASS parent
	       :XMN_AUTO_UNMANAGE   nil ;don't unmanage dialog after button click
	       )))
    (send fsb-w :add_callback :XMN_OK_CALLBACK '(CALLBACK_WIDGET)
	  '((format T "Selected File = '~A'\n"
		    (xm_string_get_l_to_r
		     (send CALLBACK_WIDGET :get :XMN_TEXT_STRING)))
	    (send CALLBACK_WIDGET :destroy))) ;get rid of fsb...
    (send fsb-w :add_callback :XMN_CANCEL_CALLBACK '(CALLBACK_WIDGET)
	  '((send CALLBACK_WIDGET :destroy))) ;get rid of fsb...
    ))

(defmethod Rolodex_Application_Widget_Class :EXIT-APP ()
  (send main-w :display-string "Exiting application ...")
  (if (winterp-standalone-p)
      (exit))
  (send-super :destroy)			;destroy TOP_LEVEL_SHELL_WIDGET_CLASS this instance
  )

(defmethod Rolodex_Application_Widget_Class :APP-HELP (xevent)
  (send main-w :display-string "Help on Application ...")
  (send main-w :call_action_proc "Help" xevent)
  )

(defmethod Rolodex_Application_Widget_Class :PICK-HELP (xevent)
  (send main-w :display-string "Click on item to display help info ...")
  (let ((picked-w 
	 (xm_tracking_locate
	  self				;confine modalness to this app-window
	  92				;X11/cursorfont.h:#define XC_question_arrow 92
	  t)))				;force confine of modalness to app-window
    (cond
     ((send picked-w :is_manager)
      (send picked-w :call_action_proc "ManagerGadgetHelp" xevent)
      )
     ((send picked-w :is_primitive)
      (send picked-w :call_action_proc "PrimitiveHelp" xevent)
      )
     (t
      (send picked-w :call_action_proc "Help" xevent)
      )
     )
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Rolodex_Form_Widget_Class
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass Rolodex_Form_Widget_Class
  (table+bbox-form-w table-w button-box-w) ;declare instance vars
  ()					;no class vars
  XM_FRAME_WIDGET_CLASS			;superclass
  )

(defmethod Rolodex_Form_Widget_Class :ISNEW (managed-kwd name-str parent-w &rest args)
  ;; create the XM_FRAME_WIDGET_CLASS inst by sending :isnew to superclass
  (apply #'send-super :isnew		;widget-inst is now bound to <self>
	 managed-kwd name-str parent-w
	 args		
	 )
  (setq table+bbox-form-w
	(send XM_FORM_WIDGET_CLASS :new :managed
	      "table+bbox-form" self
	      ))
  (setq table-w
	(send Rolodex_Table_Widget_Class :new :managed
	      "rolodex-table" table+bbox-form-w
	      :XMN_TOP_ATTACHMENT	:attach_form
	      :XMN_LEFT_ATTACHMENT	:attach_form
	      :XMN_RIGHT_ATTACHMENT	:attach_form
	      ))
  (setq button-box-w 
	(send Rolodex_Buttons_Widget_Class :new :managed
	      "button-box" table+bbox-form-w
	      table-w			;note extra arg passed in for callbacks applied to table-w
	      :XMN_TOP_ATTACHMENT	:attach_widget
	      :XMN_TOP_WIDGET		table-w
	      :XMN_LEFT_ATTACHMENT	:attach_form
	      :XMN_RIGHT_ATTACHMENT	:attach_form
	      :XMN_BOTTOM_ATTACHMENT	:attach_form
	      ))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Rolodex_Table_Widget_Class
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass Rolodex_Table_Widget_Class
  (					;declare instance vars
   name-field-w
   addrs-0-field-w
   addrs-1-field-w
   addrs-2-field-w
   hophone-field-w
   wophone-field-w
   fax-field-w
   )
  ()					;no class vars
  TABLE_WIDGET_CLASS			;superclass
  )

;; initialization method for composite widget
(defmethod Rolodex_Table_Widget_Class :ISNEW
  (managed-kwd name-str parent-w &rest args)
  ;; create the XM_TABLE_WIDGET_CLASS inst by sending :isnew to superclass
  (apply #'send-super :isnew		;widget-inst is now bound to <self>
	 managed-kwd name-str parent-w
	 :XMN_LAYOUT	"name-label    0 0 1 1 rWH;\
			 addrs-0-label 0 1 1 1 rWH;\
			 addrs-1-label 0 2 1 1 rWH;\
			 addrs-2-label 0 3 1 1 rWH;\
			 hophone-label 0 4 1 1 rWH;\
			 wophone-label 0 5 1 1 rWH;\
			 fax-label     0 6 1 1 rWH;\
			 name-field    1 0 1 1 h;\
			 addrs-0-field 1 1 1 1 h;\
			 addrs-1-field 1 2 1 1 h;\
			 addrs-2-field 1 3 1 1 h;\
			 hophone-field 1 4 1 1 h;\
			 wophone-field 1 5 1 1 h;\
			 fax-field     1 6 1 1 h;"
	 args
	 )

  (map nil #'(lambda (name-str label-str)
	       (send XM_LABEL_WIDGET_CLASS :new :managed
		     name-str self
		     :XMN_ALIGNMENT	:alignment_end
		     :XMN_LABEL_STRING	label-str
		     ))
       '("name-label" "addrs-0-label" "addrs-1-label" "addrs-2-label" "hophone-label" "wophone-label" "fax-label")
       '("Name:" "Address:" " " " " "Home Phone:" "Work Phone:" "Fax:"))

  (map nil #'(lambda (name-sym name-str)
	       (setf (send self name-sym) ;set the instance variable assoc'd with name-sym
		     (send XM_TEXT_FIELD_WIDGET_CLASS :new :managed
			   name-str self
			   )))
       '(:name-field-w :addrs-0-field-w :addrs-1-field-w :addrs-2-field-w :hophone-field-w :wophone-field-w :fax-field-w)
       '("name-field" "addrs-0-field" "addrs-1-field" "addrs-2-field" "hophone-field" "wophone-field" "fax-field"))

  (send self :add-all-callbacks)
  )

(defmethod Rolodex_Table_Widget_Class :ADD-ALL-CALLBACKS ()
  (map nil #'(lambda (widget)
	       (add-help-to-widget widget))
       (list name-field-w addrs-0-field-w addrs-1-field-w addrs-2-field-w hophone-field-w wophone-field-w fax-field-w))

  ;; this help will get called if help is called on some widget in this
  ;; composite which doesn't have it's own help callback
  (add-help-to-widget self)
  )

(defmethod Rolodex_Table_Widget_Class :PRINT-FIELDS-TO-STREAM
  (strm)
  (format strm "Name:\t'~A'\nAddrs:\t'~A'\n\t'~A'\n\t'~A'\nHome:\t'~A'\nWork:\t'~A'\nFax:\t'~A'\n"
	  (send name-field-w :get_string)
	  (send addrs-0-field-w :get_string)
	  (send addrs-1-field-w :get_string)
	  (send addrs-2-field-w :get_string)
	  (send hophone-field-w :get_string)
	  (send wophone-field-w :get_string)
	  (send fax-field-w :get_string)
	  )
  )

(defmethod Rolodex_Table_Widget_Class :CLEAR-FIELDS ()
  (map nil #'(lambda (widget)
	       (send widget :set_string "")
	       (add-help-to-widget widget))
       (list name-field-w addrs-0-field-w addrs-1-field-w addrs-2-field-w hophone-field-w wophone-field-w fax-field-w))
  )

(defmethod Rolodex_Table_Widget_Class :SEARCH-FIELDS ()
  (send self :print-fields-to-stream *standard-output*)
  (send name-field-w :set_string	"John Ousterhout")
  (send addrs-0-field-w :set_string	"Babylon Systems, Inc.")
  (send addrs-1-field-w :set_string	"4000 Dread Drive")
  (send addrs-2-field-w :set_string	"Mountain Puke, CA 94131")
  (send hophone-field-w :set_string	"(415)123-4567")
  (send wophone-field-w :set_string	"(415)891-0123")
  (send fax-field-w :set_string		"(415)666-6666")
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Rolodex_Buttons_Widget_Class
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass Rolodex_Buttons_Widget_Class
  (					;declare instance vars
   rolodex-table-w
   clear-btn-w
   add-btn-w
   search-btn-w
   delete-btn-w
   )
  ()					;no class vars
  TABLE_WIDGET_CLASS			;superclass
  )

(defmethod Rolodex_Buttons_Widget_Class :ISNEW
  (managed-kwd name-str parent-w table-w &rest args)
  (setq rolodex-table-w table-w)	;init instance variable
  ;; create the TABLE_WIDGET_CLASS inst by sending :isnew to superclass
  (apply #'send-super :isnew		;widget-inst is now bound to <self>
	 managed-kwd name-str parent-w
	 :XMN_LAYOUT	"clear-btn  0 0 1 1 WH;\
			 add-btn    1 0 1 1 WH;\
			 search-btn 2 0 1 1 WH;\
			 delete-btn 3 0 1 1 WH;"
	 args
	 )
  (setq clear-btn-w
	(send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed 
	      "clear-btn" self
	      :XMN_LABEL_STRING "Clear (^C)"
	      :XMN_ACCELERATORS "Ctrl<Key>C: ArmAndActivate()"
	      ))
  (setq add-btn-w
	(send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed 
	      "add-btn" self
	      :XMN_LABEL_STRING "Add (^A)"
	      :XMN_ACCELERATORS "Ctrl<Key>A: ArmAndActivate()"
	      ))
  (setq search-btn-w
	(send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed 
	      "search-btn" self
	      :XMN_LABEL_STRING "Search (^S)"
	      :XMN_ACCELERATORS "Ctrl<Key>S: ArmAndActivate()"
	      ))
  (setq delete-btn-w
	(send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed 
	      "delete-btn" self
	      :XMN_LABEL_STRING "Delete... (^D)"
	      :XMN_ACCELERATORS "Ctrl<Key>D: ArmAndActivate()"
	      ))
  (send self :add-all-callbacks)
  )

(defmethod Rolodex_Buttons_Widget_Class :ADD-ALL-CALLBACKS ()
  ;; callback for "clear"
  (send clear-btn-w :add_callback :XMN_ACTIVATE_CALLBACK '()
	'(
	  (send rolodex-table-w :clear-fields)
	  ))
  ;; callback for "search"
  (send search-btn-w :add_callback :XMN_ACTIVATE_CALLBACK '()
	'(
	  (send rolodex-table-w :search-fields)
	  ))
  (send add-btn-w :add_callback :XMN_ACTIVATE_CALLBACK '()
	'(
	  (send rolodex-table-w :print-fields-to-stream *standard-output*)
	  ))
  ;; ok button in question dialog box
  (send delete-btn-w :add_callback :XMN_ACTIVATE_CALLBACK '()
	'(
	  (let ((qd-w
		 (send XM_MESSAGE_BOX_WIDGET_CLASS :new :managed :question_dialog
		       "confirm_form_deletion" self
		       :XMN_TITLE		"Form Deletion Confirmation"
		       :XMN_MESSAGE_STRING	"Are You sure?"
		       :XMN_DELETE_RESPONSE	:destroy ;resource on XM_DIALOG_POPUP_SHELL_WIDGET_CLASS parent
		       :XMN_AUTO_UNMANAGE	nil ;don't unmanage dialog after button click
		       )))
	    (send qd-w :add_callback :XMN_OK_CALLBACK '()
		  '((send rolodex-table-w :clear-fields)
		    (send qd-w :destroy)))
	    (send qd-w :add_callback :XMN_CANCEL_CALLBACK '()
		  '((send qd-w :destroy)))
	    )))

  ;; help callbacks on various widgets
  (add-help-to-widget clear-btn-w)
  (add-help-to-widget add-btn-w)
  (add-help-to-widget search-btn-w)
  (add-help-to-widget delete-btn-w)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Help_Dialog_Widget_Class:
;; define a subclass of XM_MESSAGE_BOX_WIDGET_CLASS/:INFORMATION_DIALOG
;; which will look up help for a particular widget in *help-file-directory*
;; the name of the help file is named by the widget's name (as returned by
;; (send widget :name)==XtName().
;; 
;; Use 'add-help-to-widget' to register a widget for context-sensitive
;; help using the aforementioned subclass.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;
;; This function adds a help callback to a particular widget...
;;
(defun add-help-to-widget (widget)
  (send widget :add_callback :XMN_HELP_CALLBACK '()
	`(
	  (send Help_Dialog_Widget_Class :new :managed ,widget)
	  )) 
  )

(defclass Help_Dialog_Widget_Class
  ()					;no instance vars
  ()					;no class vars
  XM_MESSAGE_BOX_WIDGET_CLASS		;superclass
  )

(defmethod Help_Dialog_Widget_Class :ISNEW
  (managed-kwd parent-w &rest args)	;note: widget name generated automatically from parent-w

  ;; create the XM_MESSAGE_BOX_WIDGET_CLASS inst by sending :isnew to superclass
  (apply #'send-super :isnew		;widget-inst is now bound to <self>
	 managed-kwd :INFORMATION_DIALOG
	 (send parent-w :name)		;name of help dialog is name of widget help called 
	 parent-w
	 :XMN_MESSAGE_STRING (read-help-file-into-string (send parent-w :name))
	 :XMN_DELETE_RESPONSE :destroy ;resource on XM_DIALOG_POPUP_SHELL_WIDGET_CLASS parent
	 :XMN_AUTO_UNMANAGE  nil ;don't unmanage dialog after button click
	 args		
	 )
  (send (send self :get_child :DIALOG_HELP_BUTTON) :unmanage) ;no help on help...
  (send self :add_callback :XMN_CANCEL_CALLBACK '()
	'(
	  (send self :destroy)
	  ))
  (send self :add_callback :XMN_OK_CALLBACK '()
	'(
	  (send self :destroy)
	  ))
  )

;; file reader function used above by Help_Dialog_Widget_Class...
(defun read-help-file-into-string (help-file)
  (let
      ((fp (open (concatenate 'string *help-file-directory* help-file)
		 :direction :input))
       (res-list '())
       linestr
       )
    (if (null fp)
	(format nil "Help file '~A' not found" ;return this msg to help-dialog-box on failure
		(concatenate 'string *help-file-directory* help-file))
      (progn
	(loop
	 (if (null (setq linestr (read-line fp nil)))
	     (return))
	 (setq res-list (cons (concatenate 'string linestr "\n") res-list))
	 )
	(close fp)
	(apply #'strcat (reverse res-list)) ;return this on success
	))
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;; Support Routines ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; evaling the following prints cmd line arg to stdout
;; this is done through hack -- winterp is started up with usual
;; args... this code looks for a special bogus -xrm form. Thus, to
;; specify database 'foo', start up winterp with:
;;   winterp -enable_unix_server -xrm "bogus-resource.database: foo"
;; and "cmdline-arg = 'foo'" would get printed to stdout.
;;
(let* ((cmd-args (send *TOPLEVEL_WIDGET* :get_argv))
       (num-args (length cmd-args))
       (match-str "bogus-resource.database: ")
       (match-len (length match-str))
       )
  (do ((i 0 (1+ i)))
      ((>= i num-args)
       )
      (if (>= (length (aref cmd-args i)) match-len)
	  (if (string=  (subseq (aref cmd-args i) 0 match-len) match-str)
	      (format T "cmdline-arg = '~A'\n"
		      (subseq (aref cmd-args i) match-len NIL))
	    )
	)))

;;
;; recursive routine used in Rolodex_Application_Widget_Class/:ISNEW
;;
(defun wtree-recurse-install-accels (cur source) ;'cur' assumed to be composite
  (map nil				;for each child of composite 'cur'
       (lambda (w)			;recursively install accels...
	 (if (not (send w :is_gadget)) 
	     (send w :install_all_accelerators source) ;install on leaf node
	   )
	 (if (send w :is_composite)
	     (wtree-recurse-install-accels w source) ;recurse on tree nodes
	   )
	 )
       (send cur :get_children)		;retrieve array of children of 'cur'
       )	
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;            Create The Application             ;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;; (instatiate Rolodex_Application_Widget_Class) ;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(send Rolodex_Application_Widget_Class :new "application"
      :XMN_TITLE	"WINTERP: Toolkit Challenge Application"
      :XMN_ICON_NAME	"W:Application"
      )
